{*
  Object Pascal simple folder manipulation routines
  @Author  Maciej Zagozda (1998-2008)
  @Licence Microsoft Reciprocal License (Ms-RL)
  @Website http://www.codeplex.com/intelitechdelphirtns/
  @Version 2008/04/20 Added documentation support
}

{$DEFINE UseFileFind}

{$IFDEF VER110}
  {$DEFINE BorlandDelphi3}
{$ENDIF}

{$IFDEF VER120}
  {$DEFINE BorlandDelphi4}
{$ENDIF}

{$IFDEF VER130}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
{$ENDIF}

{$IFDEF VER140}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
{$ENDIF}

{$IFDEF VER150}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
  {$DEFINE BorlandDelphi7}
{$ENDIF}

{$IFDEF VER160}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
  {$DEFINE BorlandDelphi7}
  {$DEFINE BorlandDelphi8}
{$ENDIF}

{$IFDEF VER170}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
  {$DEFINE BorlandDelphi7}
  {$DEFINE BorlandDelphi8}
  {$DEFINE BorlandDelphi2005}
{$ENDIF}

{$IFDEF VER180}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
  {$DEFINE BorlandDelphi7}
  {$DEFINE BorlandDelphi8}
  {$DEFINE BorlandDelphi2005}
  {$DEFINE BorlandDelphi2006}
{$ENDIF}

{$IFDEF VER190}
  {$DEFINE BorlandDelphi3}
  {$DEFINE BorlandDelphi4}
  {$DEFINE BorlandDelphi5}
  {$DEFINE BorlandDelphi6}
  {$DEFINE BorlandDelphi7}
  {$DEFINE BorlandDelphi8}
  {$DEFINE BorlandDelphi2005}
  {$DEFINE BorlandDelphi2006}
  {$DEFINE BorlandDelphi2007}
{$ENDIF}

unit FolderRoutines;

interface

uses
  Classes,
  Controls,
  Dialogs,
  FileCtrl,
  FileFind,
  Forms,
  Graphics,
  Messages,
  Registry,
  {$IFDEF BorlandDelphi2007} ShlObj, ShlFolder, {$ENDIF}
  StdCtrls,
  SysUtils,
  Windows;

const
  CSIDL_LOCAL_APPDATA = $001c;
  strnShellFolders = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';

function CopyFolder( strnSource, strnDestination: AnsiString; intgCopyMode: Word ): Boolean;

{$IFDEF UseFileFind} function ClearFolder( strnFolder: AnsiString ): Boolean; {$ENDIF}
function CreateFolder( strnFolder: AnsiString ): Boolean;
function DeleteFolder( strnFolder: AnsiString ): Boolean;
function GetProfileFolder: AnsiString;
function GetChildFolder( strnFolder: AnsiString ): AnsiString;
function GetFolderSize( strnFolderName: AnsiString ): Longint;
function GetProgramFolder: AnsiString;
function GetDesktopFolder: AnsiString;
function GetFavoritesFolder: AnsiString;
{$IFDEF BorlandDelphi5} function GetFolderSize2(Path: string; ScanLabel, SizeLabel: TLabel): Int64; {$ELSE} function GetFolderSize2(Path: string; ScanLabel, SizeLabel: TLabel): comp; {$ENDIF}
function GetFontsFolder: AnsiString;
function GetLaunchFolder: AnsiString;
function GetLocalAppDataFolder: AnsiString; overload
{$IFDEF BorlandDelphi2007} function GetLocalAppDataFolder( boolForceCreate: Boolean ): AnsiString; overload {$ENDIF}
function GetParentFolder( strnFolder: AnsiString ): AnsiString;
function GetPersonalFolder: AnsiString;
function GetProgramsFolder: AnsiString;
function GetRecentsFolder: AnsiString;
function GetSendToFolder: AnsiString;
{$IFDEF BorlandDelphi2007} function GetSpecialFolder(csidl: Integer; ForceFolder: Boolean = False ): AnsiString; {$ENDIF}
function GetStartMenuFolder: AnsiString;
function GetStartupFolder: AnsiString;
function GetSystemFolder: AnsiString;
function GetTemporaryFolder: AnsiString;
function GetWindowsDrive: AnsiString;
function GetWindowsFolder: AnsiString;
function GetHierarchyCount( strnHierarchy: AnsiString ): Integer;
function GetHierarchyFolder( strnHierarchy: AnsiString; intgIndex: Integer ): AnsiString;
function ExtractFolderName( strnString: AnsiString ): AnsiString;
function FolderExists( strnString: AnsiString ): Boolean;
function TranslateFolder( strnString: AnsiString ): AnsiString;

implementation

uses
  FileRoutines,
  MessageRoutines,
  StringRoutines;

var
  // @description Variable used by one of the member functions
  {$IFDEF Delphi3Below} TotalSize: comp; {$ELSE} TotalSize: Int64; {$ENDIF}

function CopyFolder( strnSource, strnDestination: AnsiString; intgCopyMode: Word ): Boolean;
begin
  Result := False
end;

{*------------------------------------------------------------------------------
  Removes all files within specified folder

  @param strnFolder - Full path containing files to be deleted.
                      Path might be backslash terminated, or not.
  @return True on succesfull deletion, false otherwise
  @version 1.1
-------------------------------------------------------------------------------}


{$IFDEF UseFileFind}

function ClearFolder(strnFolder: AnsiString): Boolean;
var
  ffndFileFind: TFileFind;
  intgA: Integer;
  boolResult: Boolean;

begin
  boolResult := DirectoryExists(strnFolder);

  if boolResult then
  begin

    ffndFileFind := TFileFind.Create( nil );

    try
      with ffndFileFind do
      begin
        Attributes := [ffReadOnly, ffHidden, ffSystem, ffArchive];
        Directory := DeleteBackslash(strnFolder);
        Filter := '*.*';
        Recurse := False;
        Execute;

        for intgA := 0 to Files.Count - 1 do
        begin
          boolResult := boolResult and DeleteFile( PChar( Files[intgA] ));
        end;//for
      end;//with
    finally
      ffndFileFind.Free;
    end;//try
  end;//if

  Result := boolResult;
end;

{$ENDIF}


{*------------------------------------------------------------------------------
  Creates single folder or many folders forming a specified path.
  Checks if the path already exists before attempting to enforce.

  @param strnFolder - Full path to be created
  @return True on succesfull creation, false otherwise
  @version 1.0
-------------------------------------------------------------------------------}

function CreateFolder( strnFolder: AnsiString ): Boolean;
begin

  if not DirectoryExists( strnFolder ) then
  begin
    try
      Result := ForceDirectories( strnFolder );
    except
      Result := False;
    end;//try
  end
  else
  begin
    Result := True;
  end;//if

end;

{*------------------------------------------------------------------------------
  Removes single folder and files and folders within.

  @param strnFolder - Full path to be deleted. Might be backslash terminated or not.
  @return True on succesfull deletion, false otherwise
  @version 1.0
-------------------------------------------------------------------------------}

function DeleteFolder(strnFolder: AnsiString): Boolean;
var
  srcrRecord: TSearchRec;
  intgResult: Integer;
begin

  strnFolder := AppendBackslash( strnFolder );

  Result := True;

  if strnFolder = GetCurrentDir then
  begin
    SetCurrentDir( GetCurrentDir + '\..' );
  end;//if

  FillChar ( srcrRecord, SizeOf( TSearchRec ), 0 );
  intgResult := SysUtils.FindFirst( strnFolder + '*.*', faAnyFile - faVolumeID , srcrRecord );

  while intgResult = 0 do
  begin

    with srcrRecord do
    begin

      if ( Attr and faDirectory ) = faDirectory then
      begin

        if ( Name <> '.' ) and ( Name <> '..' ) then
        begin
          Result := DeleteFolder( strnFolder + srcrRecord.Name );
        end;//if

      end
      else
      begin

        FileSetAttr ( strnFolder + srcrRecord.Name , 0 );
        Result := DeleteFile( PChar( strnFolder + srcrRecord.Name ));

        if not Result then
        begin
          SysUtils.FindClose( srcrRecord );
          Result := False;
          Exit;
        end;//if
      end;//if
    end;//with

    intgResult := SysUtils.FindNext( srcrRecord ) ;

  end;//while

  SysUtils.FindClose( srcrRecord );

  try
    strnFolder := DeleteBackslash( strnFolder );
    FileSetAttr( strnFolder, 0 );
    RmDir( strnFolder );

  except
    Result := False;
  end;//try
end;

{*------------------------------------------------------------------------------
  Returns local profile folder for the currently logged in user
  This is typically C:\Documents and Settings\(Username) on Windows 2K/XP
  or C:\Users\(Username) on Windows Vista.

  @return Full path terminated with a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetProfileFolder: AnsiString;
var
  Registry: TRegistry;
begin

  Result := '';
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'AppData' ));
  end;//if

  if Result = '' then Result := GetWindowsFolder;

  Registry.Free;

end;

{*------------------------------------------------------------------------------

  Unknown

  @param strnFolder - ?
  @version 1.0
-------------------------------------------------------------------------------}

function GetChildFolder( strnFolder: AnsiString ): AnsiString;
var
  intgA: Integer;
begin

  if Copy( strnFolder, Length( strnFolder ), 1 ) = '\' then
  begin
    strnFolder := Copy( strnFolder, 1, Length( strnFolder ) - 1 );
  end;//if

  for intgA := Length( strnFolder ) downto 0 do
  begin
    if Copy( strnFolder, intgA, 1 ) = '\' then
    begin
      Break;
    end;//if
  end;//for

  if intgA <> 0 then
  begin
    Result := Copy( strnFolder, intgA + 1, 255 );
  end
  else
  begin
    Result := '';
  end;//if

end;

{*------------------------------------------------------------------------------
  Returns local desktop folder for the currently logged in user
  This is typically C:\Documents and Settings\Desktop on Windows 2K/XP
  Caters for different Windows locale versions, which call desktop differently

  @return Full path terminated with a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetDesktopFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Desktop' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns local favourites folder for the currently logged in user
  Caters for different Windows locale versions, which call desktop differently

  @return Full path terminated with a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetFavoritesFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Favorites' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;


{*------------------------------------------------------------------------------
  Returns date and time properties of a folder
  This function is compatible with Borland Delphi 7 and later.

  @param strFolder - full path to a folder to be examined
  @param dateCreated - return parameter for date and time when the folder was created
  @param dateAccessed - return parameter for date and time when the folder was last accessed
  @param dateWritten - return parameter for date and time when the folder was last written
  @return True if examination was succesfull or false otherwise
  @version 1.0
-------------------------------------------------------------------------------}

{$IFDEF BorlandDelphi7}

function GetFolderDateTime(const strFolder: AnsiString; var dateCreated: TDateTime; var dateAccessed: TDateTime; var dateModified: TDateTime; var dateWritten: TDateTime): Boolean;
var
  srecDefault: TSearchRec;
  sdtmCreated: TSystemTime;
  sdtmAccessed: TSystemTime;
  sdtmModified: TSystemTime;
  sdtmWritten: TSystemTime;
begin
  if SysUtils.FindFirst(strFolder, faDirectory, srecDefault) = 0 then
  try
    try
      dateModified := FileDateToDateTime(srecDefault.Time) ;

      FileTimeToSystemTime(srecDefault.FindData.ftCreationTime, sdtmCreated) ;
      with sdtmCreated do dateCreated := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds) ;

      FileTimeToSystemTime(srecDefault.FindData.ftLastAccessTime, sdtmAccessed) ;
      with sdtmAccessed do dateAccessed := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds) ;

      FileTimeToSystemTime(srecDefault.FindData.ftLastWriteTime, sdtmWritten) ;
      with sdtmWritten do dateWritten := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds) ;

    except
      Result := False;
    end;//try
  finally
    SysUtils.FindClose(srecDefault);
  end
  else
  begin
    Result := False;
  end;
end;
{$ENDIF BorlandDelphi7}

{*------------------------------------------------------------------------------
  Returns size of a folder by calculating size of files within

  @param strFolderName - full path to a folder to be examined
  @return Size in bytes of all files contained in the folder
  @version 1.0
-------------------------------------------------------------------------------}

function GetFolderSize( strnFolderName: AnsiString ): Longint;
var
  srcrRecord: TSearchRec;
  intgTemporary: Longint;
  intgResult: Longint;

begin

  strnFolderName := AppendBackslash( strnFolderName );
  intgTemporary := 0;
  Result := -1;

  if strnFolderName = GetCurrentDir then
  begin
    SetCurrentDir ( GetCurrentDir + '\..' );
  end;//if

  FillChar ( srcrRecord, SizeOf( TSearchRec ), 0 );
  intgResult := SysUtils.FindFirst( strnFolderName + '*.*', faAnyFile - faVolumeID , srcrRecord );

  while intgResult = 0 do
  begin

    with srcrRecord do
    begin

      if ( Attr and faDirectory ) = faDirectory then
      begin

        if ( Name <> '.' ) and ( Name <> '..' ) then
        begin
          intgTemporary := intgTemporary + GetFolderSize( strnFolderName + srcrRecord.Name );
        end;//if

      end
      else
      begin

        intgTemporary := intgTemporary + Size;

      end;//if
    end;//with

    intgResult := SysUtils.FindNext( srcrRecord ) ;

  end;//while

  SysUtils.FindClose( srcrRecord );
  Result := intgTemporary;

end;

{*------------------------------------------------------------------------------
  Returns size of a folder by calculating size of files within.
  This procedure is maintained for compatibility with Delphi 3.
  You can pass 2 TLabels for a progress while scanning:
  ScanLabel: will display the current path being scanned
  SizeLabel: will display the total size so far counted.
  If you don't want to use either Labels, pass nil to both.
  You can still use returned value to read the total size.

  Example:
  (For Delphi 4/5)
    TotalSize := 0;
    Label1.Caption := IntToStr(DirSize('C:\Windows', nil, nil)) + ' bytes';
  (For Delphi 3)
    TotalSize := 0;
    Label1.Caption := FloatToStr(DirSize('C:\Windows', nil, nil)) + ' bytes';
  (It is a little faster this way.)

  You must initialize the TotalSize variable to 0 before using this function.

  @param Path - full path to a folder to be examined
  @return Size in bytes of all files contained in the folder
  @version 1.0
-------------------------------------------------------------------------------}

{$IFDEF Delphi3Below}
function GetFolderSize2(Path: string; ScanLabel, SizeLabel: TLabel): comp;
{$ELSE}
function GetFolderSize2(Path: string; ScanLabel, SizeLabel: TLabel): Int64;
{$ENDIF}
var
  Res: Integer;
  SR: TSearchRec;
begin
  Result := TotalSize;
  if Copy(Path, Length(Path), 1) <> '\' then Path := Path + '\';
  if not DirectoryExists(Path) then
  begin
    Result := -1;
    Exit;
  end;

  if ScanLabel <> nil then
  begin
    ScanLabel.Caption := 'Scanning ' + Path;
    ScanLabel.Update;
  end;

  Res := FindFirst(Path + '*.*', faAnyFile, SR);
  try
    while Res = 0 do
    begin
      if (SR.Name [1] <> '.') and (SR.Name [1] <> '..') then
      begin
        if ((SR.Attr and faDirectory) <> 0) then
        begin
          GetFolderSize2(Path + SR.Name + '\', ScanLabel, SizeLabel);
        end
        else
        begin
          TotalSize := TotalSize + SR.Size;
        end;//if
      end; // if

      Res := FindNext(SR);
      if SizeLabel <> nil then
      begin
        {$IFDEF Delphi3Below}
        SizeLabel.Caption := 'Total size: ' + FloatToStr(TotalSize) + ' bytes';
        {$ELSE}
        SizeLabel.Caption := 'Total size: ' + IntToStr(TotalSize) + ' bytes';
        {$ENDIF}
        SizeLabel.Update;
      end;//if
    end;
  finally
    SysUtils.FindClose(SR);
  end;
  Result := TotalSize;
end;


{*------------------------------------------------------------------------------
  Returns local fonts folder for the currently logged in user
  Caters for different Windows locale versions, which can call Fonts folder differently

  @return Full path to the Fonts folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetFontsFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Desktop' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns quick launch folder for the currently logged in user
  Does not cater for different Windows locale versions

  @return Full path to the Quick Launch folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetLaunchFolder: AnsiString;
begin
  Result := GetProfileFolder + 'Microsoft\Internet Explorer\Quick Launch\';
end;

{*------------------------------------------------------------------------------
  Returns local application data the currently logged in user
  This is typically C:\Documents and Settings\(Username)\AppData
  Does cater for different Windows locale versions
  Does not cater for Windows Vista

  @return Full path to the Application Data folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetLocalAppDataFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  If Registry.OpenKeyReadOnly( strnShellFolders ) Then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Local AppData' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns local application data the currently logged in user
  This is typically C:\Documents and Settings\(Username)\AppData
  Does handle different Windows locale versions
  Does handle Windows Vista

  Note: this procedure is compatible with Delphi 2007 and higher

  @param boolForceCreate ensures that the folder is created if it doesn't exist
  @return Full path to the Application Data folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

{$IFDEF BorlandDelphi2007}

function GetLocalAppDataFolder( boolForceCreate: Boolean ): AnsiString;
begin
  Result := GetSpecialFolder( CSIDL_LOCAL_APPDATA, boolForceCreate );
end;

{$ENDIF}

{*------------------------------------------------------------------------------
  Returns the parent folder of the last folder in the specified path

  @param strnFolder - path to a folder being examined
  @return Path to a folder being a parent of the strnFolder
  @version 1.0
-------------------------------------------------------------------------------}

function GetParentFolder( strnFolder: AnsiString ): AnsiString;
var
  intgA: Integer;
begin

  if Copy( strnFolder, Length( strnFolder ), 1 ) = '\' then
  begin
    strnFolder := Copy( strnFolder, 1, Length( strnFolder ) - 1 );
  end;//if

  for intgA := Length( strnFolder ) downto 0 do
  begin
    if Copy( strnFolder, intgA, 1 ) = '\' then
    begin
      Break;
    end;//if
  end;//for

  if intgA <> 0 then
  begin
    Result := Copy( strnFolder, 1, intgA );
  end
  else
  begin
    Result := '';
  end;//if
end;

{*------------------------------------------------------------------------------
  Returns the personal folder containing My Documents
  This is typically: C:\Documents and Settings\(username)\My documents folder
  Does handle different Windows 2K/XP versions and different Windows locale

  @return Path to the personal folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetPersonalFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Personal' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns the folder in which the current application is executed
  This is typically the folder, where the application executable is placed

  @return Path to the application folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetProgramFolder: AnsiString;
begin
  Result := AppendBackslash( ExtractFilePath( Application.ExeName ));
end;

{*------------------------------------------------------------------------------
  Returns the folder containing Program Files
  This is typically C:\Program Files folder

  @return Path to the Program Files folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetProgramsFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Programs' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns the folder containing shortcuts to current user's recent files
  This is typically C:\Documents and Settings\(username)\Recent

  @return Path to the Recent folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetRecentsFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Recent' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns the folder containing shortcuts to Send To files
  This is typically C:\Documents and Settings\(username)\SendTo

  @return Path to the Send To folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetSendToFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'SendTo' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  General routine for returning paths to special folders.
  Introduced in order to provide access to some of the new special folders in Windows Vista.
  Designed to work with Borland Delphi 2007 and later

  @param csidl: variable indicating type of folder
  @param ForceFolder: optional indicator to create the folder if it does not exists
  @return Path to the Send To special folder
  @version 1.0
-------------------------------------------------------------------------------}

{$IFDEF BorlandDelphi2007}

function GetSpecialFolder(csidl: Integer; ForceFolder: Boolean = False ): AnsiString;
var
  i: integer;
begin
  SetLength( Result, MAX_PATH );
  if ForceFolder then
  begin
    SHGetFolderPath( 0, csidl or CSIDL_FLAG_CREATE, 0, 0, PChar( Result ));
  end
  else
  begin
    SHGetFolderPath( 0, csidl, 0, 0, PChar( Result ));

  end;

  i := Pos( #0, Result );
  if i > 0 then SetLength( Result, Pred(i));

end;

{$ENDIF}

{*------------------------------------------------------------------------------
  Returns the folder containing shortcuts in the Start Menu folder
  This is typically C:\Documents and Settings\(username)\Start Menu

  @return Path to the Start Menu folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetStartMenuFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Start Menu' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns the folder containing shortcuts in the Startup (Autostart) folder
  This is typically C:\Documents and Settings\(username)\Menu Start\Programs\Startup folder

  @return Path to the Start Menu Startup folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetStartupFolder: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;

  if Registry.OpenKeyReadOnly( strnShellFolders ) then
  begin
    Result := AppendBackslash( Registry.ReadString( 'Startup' ));
  end
  else
  begin
    Result := '';
  end;//if

  Registry.Free;
end;

{*------------------------------------------------------------------------------
  Returns the system folder for the current installation of Windows
  This is typically C:\Windows\System folder for Windows 95/98/ME
  This is typically C:\Windows\System32 folder for Windows 2K/XP/Vista

  @return Path to the System folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetSystemFolder;
var
  charSystemFolder: Array[0..255] Of Char;
begin
  GetSystemDirectory( charSystemFolder, 255 );
  Result := AppendBackslash( StrPas( charSystemFolder ));
end;

{*------------------------------------------------------------------------------
  Returns the temporary folder for the current installation of Windows
  Does cater for different Windows locale
  Does cater for multiuser workstations
  This is typically C:\Windows\Temp folder for Windows 95/98/ME
  This is typically C:\Documents and Settings\(username)\Local Settings\Temporary folder for Windows 2K/XP/Vista

  @return Path to the temp folder terminated by a backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetTemporaryFolder: AnsiString;
var
  charTempFolder: Array[0..255] Of Char;
begin
  GetTempPath( 255, charTempFolder );
  Result := AppendBackslash( StrPas( charTempFolder ));
end;

{*------------------------------------------------------------------------------
  Returns the root path of the drive, where Windows is installed
  This is typically C:\ on single hard disk machines

  @return the drive terminated by the backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetWindowsDrive: AnsiString;
var
  charWindowsDir: Array[0..255] Of Char;
begin
  GetWindowsDirectory( charWindowsDir, 255 );
  Result := UpperCase( Copy( StrPas( charWindowsDir ), 1, 3 ));
end;

{*------------------------------------------------------------------------------
  Returns the folder for the current installation of Windows
  This is typically C:\Windows\ folder for Windows 95/98/ME
  This is typically C:\Winnt\ folder for Windows 2K/XP/Vista

  @return the drive terminated by the backslash
  @version 1.0
-------------------------------------------------------------------------------}

function GetWindowsFolder: AnsiString;
var
  charWindowsFolder: Array[0..255] Of Char;
begin
  GetWindowsDirectory( charWindowsFolder, 255 );
  Result := AppendBackslash( StrPas( charWindowsFolder ));
end;

{*------------------------------------------------------------------------------
  Counts number of folders in provided path

  @param strnHierarchy - path to be examined
  @return the number of hierachy levels in the specified path
  @version 1.0
-------------------------------------------------------------------------------}

function GetHierarchyCount( strnHierarchy: AnsiString ): Integer;
begin

  Result := 0;

  while Pos( '\', strnHierarchy ) > 0 do
  begin

    strnHierarchy := Copy( strnHierarchy, Pos( '\', strnHierarchy ) + 1, Length( strnHierarchy ));
    Result := Result + 1;

  end;//while

end;

{*------------------------------------------------------------------------------
  Returns the name of a folder of a given index in the specified path

  @param strnHierarchy - path to be examined
  @param intgIndex - zero based index of folder name in the hierachy of the path
  @return name of the folder at the given index in the hierarchy
  @version 1.0
-------------------------------------------------------------------------------}

function GetHierarchyFolder( strnHierarchy: AnsiString; intgIndex: Integer ): AnsiString;
var
  strnString: AnsiString;
  intgA: Integer;
begin

  strnString := strnHierarchy;

  for intgA := 0 to intgIndex - 1 do
  begin
    strnString := Copy( strnString, Pos( '\', strnString ) + 1, Length( strnString ));
  end;//for

  strnString := Copy( strnString, 1, Pos( '\', strnString ) - 1 );

  if strnString <> strnHierarchy then
  begin
    Result := strnString;
  end
  else
  begin
    Result := '';
  end;//if

end;

{*------------------------------------------------------------------------------
  Extracts folder name from file name

  @param strnString - string containing folder name and file name
  @return folder name in which the file resides
  @version 1.0
-------------------------------------------------------------------------------}

function ExtractFolderName( strnString: AnsiString ): AnsiString;
label
  lblRepeat;
var
  intgA: Integer;
begin

  strnString := DeleteBackslash( strnString );

  lblRepeat:

  intgA := Pos( '\', strnString );
  if intgA > 0 then
  begin
    strnString := Copy( strnString, intgA + 1, 255 );
    Goto lblRepeat;
  end;//if

  Result := strnString;

end;

{*------------------------------------------------------------------------------
  Checks if a folder name exists

  @param strnString - foler name to examine
  @return True if folder exists, false otherwise
  @version 1.0
-------------------------------------------------------------------------------}

function FolderExists( strnString: AnsiString ): Boolean;
var
  strnCurrentDirectory: AnsiString;
begin
  strnCurrentDirectory := GetCurrentDir;
  Result := SetCurrentDirectory( PChar( strnString ));
  SetCurrentDir( PChar( strnCurrentDirectory ));
end;

{*------------------------------------------------------------------------------
  Returns a special folder location using a string identifier of a special folder to be returned.
  Parses given string and replaces it with folder location(s) matching accepted identifiers.

  Recognised identifiers:
  <DESKTOPFOLDER>, <FAVORITESFOLDER>, <FONTSFOLDER>, <MENUSTARTFOLDER>, <PROGRAMSFOLDER>
  <RECENTSFOLDER>, <SENDTOFOLDER>, <SYSTEMFOLDER>, <TEMPORARYFOLDER>,
  <WINDOWSFOLDER>, <WINDOWSVOLUME>, <LAUNCHFOLDER>
  <SOURCEFOLDER> - gets the folder where program's executable is running

  @param strnString - textual identifier of a special folder to be returned
  @return string with special folder(s) identifiers replaced by special folder paths, backslash terminated
  @version 1.0
-------------------------------------------------------------------------------}

function TranslateFolder( strnString: AnsiString ): AnsiString;
var
  strnA: AnsiString;
begin

  while Pos( '<', strnString ) > 0 do
  begin

    strnA := strnString;

    if Pos( '<desktopfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<desktopfolder>', GetDesktopFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<favoritesfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<favoritesfolder>', GetFavoritesFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<fontsfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<fontsfolder>', GetFontsFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<menustartfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<menustartfolder>', GetStartMenuFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<programsfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<programsfolder>', GetWindowsDrive + 'Program Files\', [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<recentsfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<recentsfolder>', GetRecentsFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<sendtofolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<sendtofolder>', GetSendToFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<sourcefolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<sourcefolder>', GetProgramFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<systemfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<systemfolder>', GetSystemFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<temporaryfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<temporaryfolder>', GetTemporaryFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<windowsfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<windowsfolder>', GetWindowsFolder, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<windowsvolume>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<windowsvolume>', GetWindowsDrive, [rfReplaceAll, rfIgnoreCase] );
    if Pos( '<launchfolder>', LowerCase( strnString )) > 0 then strnString := StringReplace( strnString, '<launchfolder>', GetLaunchFolder, [rfReplaceAll, rfIgnoreCase] );

    if strnString = strnA then Break;

  end;//while

  Result := strnString;

end;

end.


